MODULE = PlPN          PACKAGE = PlPN::ScriptRunner

#
# Pod::Html is kind of brain-dead:
#
# Place Z<> between function names and parentheses, otherwise Pod::Html
# assumes you meant to put C<...> around it
#
# Put explicit text in all links L<use my text, stupid|some::perl::module>,
# otherwise Pod::Html assumes you want "the X manpage". (Does not apply to
# relative links withing this file.)
#
# It also assumes you want a link if you have C<...> with text matching a
# potential link target. The only way I've found around that is to split it
# up into multiple pieces: C<wo>C<rd>. Looks correct in the resulting HTML,
# but it's ugly to have <code>wo</code><code>rd</code> in the source, and I
# shouldn't have to do it.
#

=head1 NAME

PlPN::ScriptRunner - The script runner object

=head1 SYNOPSIS

	{
		package MyScriptRunnerWithUniqueClassName;
		use PlPN;
		our @ISA = qw(PlPN::ScriptRunner);
		
		sub new {
			my $class = shift;
			my $self = $class->SUPER::new(@_);
			# do something with $self
			return $self;
		}
		
		sub RunScript {
			# do something
		}
		
		# etc.
	} # scope ends; return to original package
	
	use PlPN qw(PN);
	
	my $runner = new MyScriptRunnerWithUniqueClassName;	
	$runner->{scripts}{'unique_script_id'} = $some_subref;
	
	my $reg = PN->GetScriptRegistry;
	$reg->RegisterRunner('unique_scriptrunner_id', $runner);
	$reg->Add('script_group', 'script_name', 'unique_scriptrunner_id:unique_script_id');
	
	# etc.

=head1 DESCRIPTION

Runs scripts when requested by Programmer's Notepad.

Please note that you must I<both> register a script with
L<PlPN::ScriptRegistry|PlPN::ScriptRegistry> I<and> allow the runner to
access the script. The default implementation of C<PlPN::ScriptRunner> is a
blessed hashref. Scripts are stored in the C<scripts> element of that hash,
which is a hashref. They key is the unique script id and the value is the
subref to be executed.

You could just as easily store the scripts outside the runner object
(provided that whatever variable you're storing them in is available from
the runner's scope), or store them in an array with the index as the unique
script id, or store them as strings instead of subrefs.

=head1 CONSTRUCTOR

=over

=item new PlPN::ScriptRunner

Creates a script runner object. If you implement your own constructor, you
B<must> call this class's version, because it creates the associated C++
object. The blessed hashref returned by C<new> allows access to the
underlying C++ object, which is used by
L<PlPN::ScriptRegistry::Add|PlPN::ScriptRegistry/Add>. In other words,
you're pretty much stuck with this object.

=back

=cut

PerlScriptRunner*
PerlScriptRunner::new()
	CODE:		
		RETVAL = new PerlScriptRunner(CLASS);
	OUTPUT:
		RETVAL

# Strangely, I keep getting an error about PerlScriptRunner* not being defined in the typemap
# - even though RunScript() has no problem with it. So I had to comment it out
# and roll my own
#void
#PerlScriptRunner::DESTROY()

void
DESTROY(perl_obj);
		SV* perl_obj;
	CODE:
		PerlScriptRunner* psr = (PerlScriptRunner*)retrieve_cpp_object(perl_obj);
		if (psr->InUse()) {
			psr->InUse(false);
			my_pn->GetScriptRegistry()->RemoveRunner(psr->Id());
		}
		delete psr;

FALLBACK: TRUE

bool
eq(a,b,swap)
		PerlScriptRunner* a;
		PerlScriptRunner* b;
		IV swap;
	OVERLOAD: ==
	CODE:
		RETVAL = (a == b);
	OUTPUT:
		RETVAL

#
# xsubpp only generates the following code for the module, not for the
# individual packages. In our case, that's less than useful, because the
# module does not, in fact, have overloaded operators.
# See the boot section in the generated code for an explanation of what the
# following code does
#
BOOT:
PL_amagic_generation++;
sv_setsv(
	get_sv( "PlPN::ScriptRunner::()", TRUE ),
	&PL_sv_yes	// or &PL_sv_no or &PL_sv_undef
);
(void)newXSproto_portable("PlPN::ScriptRunner::()", XS_PlPN_nil, file, "$$$");

=head1 EVENTS

=over

=item RunScriptZ<>($script_id)

Called when a user selects the script from the Scripts window. (Unless that
script was added by selecting C<Use as Script> from the document window's
context menu; see L</RunDocScript> below.)

The default version stores scripts in a hashref with the script id as the
key and a subref as the value. When it receives this event, it calls the
subref corresponding to the script id.

=cut

void
PerlScriptRunner::RunScript(name)
		const char* name;
	CODE:
		SV** scriptstore = hv_fetch(
			(HV*)SvRV(THIS->GetPerlObj()),	/* target */
			"scripts",						/* key */
			7,								/* key length */
			0								/* is this fetch part of a store? */
		);
		if (scriptstore == NULL) {
			alert("No scripts found in PerlScriptRunner object");
			XSRETURN(0);
		}
		
		SV** subref = hv_fetch(
			(HV*)SvRV(*scriptstore),	/* target */
			name,						/* key */
			strlen(name),				/* key length */
			0							/* is this fetch part of a store? */
		);
		if (subref == NULL) {
			alert("No script entry found for %s", name);
			XSRETURN(0);
		}
		else {
			ENTER;
			SAVETMPS;

	        PUSHMARK(SP);
			call_sv(*subref, G_VOID|G_NOARGS|G_EVAL);
			PUTBACK;

			if(SvTRUE(ERRSV)) {
				STRLEN n_a;
				alert("Error calling Perl version of RunScript: %s\n", SvPV(ERRSV,n_a));
			}

			FREETMPS;
			LEAVE;
		}

=item RunDocScriptZ<>($doc)

Called when the user selects a script that was added by selecting C<Use as
Script> from the document window's context menu. C<$doc> is a
L<PlPN::Document|PlPN::Document> object.

The default implementation uses the document object to get the filename and
runs the file. In other words, it uses the last saved version of the
document, not whatever is currently in the document.

=cut

void
PerlScriptRunner::RunDocScript(doc)
		extensions::IDocumentPtr doc;
	CODE:
		SV* object = get_sv("PlPN::PlPN", 1);	// 1 means Perl will create if it doesn't exist
		char* filename = wide_2_utf8(doc->GetFileName());
		
		ENTER;
		SAVETMPS;

		PUSHMARK(SP);
		XPUSHs(object);
		XPUSHs(sv_2mortal(newSVpv(filename, 0)));	// 0 means Perl will calculate length
		PUTBACK;
		
		call_method("eval_file", G_VOID|G_EVAL);
		SPAGAIN;

		if(SvTRUE(ERRSV)) {
			STRLEN n_a;
			alert("Error calling Perl version of RunDocScript: %s\n", SvPV(ERRSV,n_a));
		}

		PUTBACK;
		FREETMPS;
		LEAVE;

		// caller responsible for freeing memory after wide_2_utf8
		free((void*)filename);

=item EvalZ<>($script)

I have only found one place where this event is called. If a user creates a
tool with the (undocumented) special symbol C<&{runnerId:code}>, this event
will be called on the runner with the given id, and C<$script> will be
whatever follows the colon.

As a very simple example, the default runner created by the L<PlPN|PlPN>
object has the id C<perl>. So the special symbol
C<&{perl:$PlPN::PluginVersion}> will be replaced with the PlPN plugin
version.

=cut

SV*
PerlScriptRunner::Eval(script)
		const char* script;
	CODE:
		RETVAL = eval_pv(script, 0);	// 0 to not croak on error
		SvREFCNT_inc(RETVAL);

		if(SvTRUE(ERRSV)) {
			STRLEN n_a;
			alert("Error calling Perl version of Eval: %s\n", SvPV(ERRSV,n_a));
		}
//alert("About to leave XS with '%s'", SvPV_nolen(RETVAL));
	OUTPUT:
		RETVAL

=item ExecZ<>($function, $param, $flags)

The system uses this event to request you to run C<$function>. The C<$flags>
parameter indicates how the function should be executed. The execution flags
are exposed via the C<:EExecFlags> tag in L<PlPN|PlPN>. These constants are:

=over

=item efCaptureOutput

=item efBuiltIn

=back

C<ef>C<CaptureOutput> indicates that this event should return the printed
output of the function, not the return value. The default version of the
event interprets C<ef>C<BuiltIn> to mean that the function should be called
as a method of the L<PlPN|PlPN> object intead of a method of the script
runner object.

The default version of this event handles C<$flags> itself, and calls
C<$object-E<gt>$function($param)> (after determing C<$object> as indicated
above).

There are only three places where this event is called, and every one of
those places first checks  whether a script runner has been registered with
the id C<python> and if so, calls the event on that runner only.

It is possible to employ what I call the B<python hack>: write your own
runner and register it with the id C<python>. Be aware, however, that this
will cause a conflict with PyPN, and with anyone else using the hack.

Under the document window is a small field where you can enter text. This is
called the command bar. Every time a character is entered into this field,
C<Ex>C<ec('evalCommand', $text, efBuiltIn)> is called, with the contents of
the field in C<$text>. The text in the field is replaced with the return
value of C<evalCommand>.

When the enter key is hit in the command bar,
C<Ex>C<ec('evalCommandEnter', $text, efBuiltIn)> is called, under the same
conditions as above (including the replacing of the text with the return
value). (PyPN uses the command bar to implement C<vi>-like commands via
these two methods, but you can do whatever you want with it.)

When backticks are used in a text clip, C<Ex>C<ec('evalScript', $text,
efBuiltIn|efCaptureOutput)> is called, with the text between the backticks
in C<$text>. The backtick expression is replaced with the return value of
C<evalScript>.

Please note that if you choose to use the python hack with the builtin
functionality for this event, you will need to create the methods
C<PlPN::evalCommand>, C<PlPN::evalCommandEnter>, and C<PlPN::evalScript>.
Remember that the first parameter will be the object reference, and the
second parameter will be the C<$param> that was passed to the event.

=cut

SV*
PerlScriptRunner::Exec(function, param, flags)
		const char* function;
		SV* param;
		int flags;
	CODE:
		SV* object;
		SV* redirect;
		if (flags & extensions::efBuiltIn) {
			// we're to be called on the PlPN object
			object = get_sv("PlPN::PlPN", 1);	// 1 means Perl will create if it doesn't exist
		}
		else {
			// we're to be called on the ScriptRunner object
			object = THIS->GetPerlObj();
		}
		
		ENTER;
		SAVETMPS;

		if (flags & extensions::efCaptureOutput) {
			// return the STDOUT of the script
			redirect = newSVpvn("", 0);
			PUSHMARK(SP);
			XPUSHs(newRV_noinc(redirect));
			PUTBACK;
			
			call_pv("PlPN::redirect_stdout", G_VOID|G_EVAL);
			SPAGAIN;

			if(SvTRUE(ERRSV)) {
				STRLEN n_a;
				alert("Error redirecting stdout: %s\n", SvPV(ERRSV,n_a));
			}
		}

		PUSHMARK(SP);
		XPUSHs(object);
		XPUSHs(param);
		PUTBACK;
		
		int count = call_method(function, G_SCALAR);
		SPAGAIN;

		if(SvTRUE(ERRSV)) {
			STRLEN n_a;
			alert("Error calling Perl version of Exec: %s\n", SvPV(ERRSV,n_a));
		}

		if (flags & extensions::efCaptureOutput) {			
			call_pv("PlPN::restore_stdout", G_VOID|G_NOARGS|G_EVAL);
			SPAGAIN;

			if(SvTRUE(ERRSV)) {
				STRLEN n_a;
				alert("Error restoring stdout: %s\n", SvPV(ERRSV,n_a));
			}

			RETVAL = redirect;
		}
		else {
			if (count != 1) {
				alert("Method %s did not return a value");
				RETVAL = &PL_sv_undef;
			}
			else {
				RETVAL = POPs;
				SvREFCNT_inc(RETVAL);
				PUTBACK;
			}
		}
	
		FREETMPS;
		LEAVE;
	OUTPUT:
		RETVAL

=back

=head1 COPYRIGHT and LICENCE

Copyright (c) 2012 Sean Healy. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
